open SwfTypes

external new_mobj: string -> 'a jhmtasc_type -> int = "newObj"
external call_method: int -> string -> 'a jhmtasc_type -> 'a jhmtasc_type = "callMethod"
external getMField: 'a jhmtasc_type -> string -> 'a jhmtasc_type = "getField"
external setMField: 'a jhmtasc_type -> 'a jhmtasc_type -> 'a jhmtasc_type = "setField"

(* TODO permettre les call sur des methodes static pour eviter les creations d'instances inutilisees *)
(* TODO faire une primitive assert pour remonter proprement les exception internes...*)

let asInt obj =
    match obj with
        | JInt a -> a
        | _ -> assert false

let asIntOption obj =
    match obj with
        | JIntOption a -> a
        | _ -> assert false

let asBool obj =
    match obj with
        | JBool a -> a
        | _ -> assert false

let asString obj =
    match obj with
        | JString a -> a
        | _ -> assert false

let asList obj =
    match obj with
        | JDynArray a -> a
        | _ -> assert false

let asMap obj =
    match obj with
        | JHashTable a -> a
        | _ -> assert false
(*
let asStringList obj =
    match obj with
        | JStringList l -> l
        | _ -> assert false
*)

let emptyJNup = JNup (JVoid,JVoid)

let mapCreate arg =  new_mobj "JHashMap" (JArray arg)

let mapAdd obj arg1 arg2 =
    let res = call_method obj "add" (JArray [arg1;arg2]) in
    match res with
        | _ -> ()

let mapReplace hashObj obj =
    let res = call_method hashObj "replace" (JArray [obj]) in
        match res with
            | _ -> ()

let mapGet obj arg =
    call_method obj "get" (JArray [arg])

let mapGetKey obj arg =
    call_method obj "getKey" (JArray [arg])

let mapRemove obj arg =
    let res = call_method obj "remove" (JArray [arg]) in
        match res with
            | _ -> ()

let mapLength obj = asInt (call_method obj "length" (JArray []))
let mapFind obj arg = call_method obj "find" (JArray [arg])
let mapMem obj arg = asBool (call_method obj "mem" (JArray [arg]))


(* TODO: HAS TO BE IMPLEMENTED *)
let mapFold f1 obj a =
    obj

let listCreate arg = new_mobj "JArrayList" (JArray arg)

let listRev obj =
    let res = call_method obj "rev" (JArray []) in
        match res with
            | _ -> ()

let listAdd obj  args =
    let res = call_method obj "add" (JArray [args]) in
        match res with
            | _ -> ()

let listInsert obj idx value =
    let res = call_method obj "insert" (JArray [JInt idx;value]) in
        match res with
            | _ -> ()

let listRemoveLast obj =
    let res = call_method obj "removeLast" (JArray []) in
        match res with
            | _ -> ()

let listLast obj =
    call_method obj "last" (JArray [])

let listLength obj = asInt (call_method obj "length" (JArray []))

let listSet obj idx value =
    let res = call_method obj "set" (JArray [JInt idx;value]) in
        match res with
            | _ -> ()

let listGet obj idx =
    call_method obj "get" (JArray [JInt idx])

(* TODO: HAS TO BE IMPLEMENTED *)
let listFoldLeft f a obj =
     match a with
        | n -> n

let listExists obj elt = asBool (call_method obj "exists" (JArray [elt]))

let listRemove obj idx =
    let res = call_method obj "remove" (JArray [JInt idx]) in
    match res with
        | _ -> ()

let listConcat list1 list2 =
    asList (call_method list1 "concat" (JArray [JDynArray list2]))

let stringSplit str token =
    let obj = new_mobj "MString" (JArray []) in
    asList (call_method obj "nsplit" (JArray [JString token]))

let newLocalCtx reg sp =
    new_mobj "MLocalCtx" (JArray [JInt reg;JInt sp])

let newSuperBindingsObj path fname flag =
    new_mobj "MSuperBindingsObj" (JArray [JStringList path;JString fname;JBool flag])

let newTagsObj str hashtable listObj =
    new_mobj "MTagsObj" (JArray [JString str; JHashTable hashtable; JDynArray listObj])

let newTag id ext data =
    new_mobj "MTag" (JArray ([(JInt id);(JBool ext);(JTagData data)]))

let newClip id framecount tags =
    new_mobj "MClip" (JArray ([(JInt id);(JInt framecount);(JArray tags)]))

let asExport obj =
    match obj with
        | JExport e -> e
        | _ -> assert false

let newExport id name =
    new_mobj "MExport" (JArray ([(JInt id);(JString name)]))

let newDoInitAction id ops =
    new_mobj "MDoInitAction" (JArray ([(JInt id);(JActions ops)]))

let toStringList strList =
    let res = ref [] in
    for i=0 to (listLength strList) do
        res := (asString (listGet strList i)) :: !res;
    done;
    !res

let asAction obj =
    match obj with
        | JAction a -> a
        | _ -> assert false

let newAction act =
    new_mobj "JAction" (JActionType act)

let asActionType obj =
    let res = call_method obj "asType" JVoid in
    match res with
        | JActionType atype -> atype
        | _ -> assert false
(*
let asActions obj =
    match obj with
        | JActions acts -> acts
        | _ -> assert false

let newActions listActions =
    let jListItems = ref [] in
    List.iter (fun act -> jListItems := JActionType act :: !jListItems) listActions;
    new_mobj "MActions" (JArray !jListItems)

let asPushItemType obj =
    let res = call_method obj "asType" JVoid in
    match res with
        | JPushItemType ptype -> ptype
        | _ -> assert false

let asPushItem obj =
    match obj with
        | JPushItem pit -> pit
        | _ -> assert false

let newPushItems listItems =
    let jListItems = ref [] in
    List.iter (fun it -> jListItems := JPushItemType it :: !jListItems) listItems;
    new_mobj "MDynArray" (JArray !jListItems)

let newTry style trylen catchlen finallylen =
    let margs = [JTryStyleType style ; JInt trylen ; JIntOption catchlen ; JIntOption finallylen] in
    new_mobj "MTry" (JArray margs)

let getTryStyleType tryObj =
    let tryStyle = match (getMField (JTry tryObj) "tryStyle") with
        | JTryStyle tryStyle -> tryStyle
        | _ -> assert false
    in match (call_method tryStyle "asType" JVoid) with
        | JTryStyleType tryStyleType -> tryStyleType
        | _ -> assert false

let asFlagsList obj =
    match obj with
        | JFlagsList flags -> flags
        | _ -> assert false

let asFuncDecl obj =
    match obj with
        | JFuncDecl fdecl -> fdecl
        | _ -> assert false

let asFunc2Decl obj =
    match obj with
        | JFunc2Decl f2decl -> f2decl
        | _ -> assert false

let newFunc2Decl name flags args nregs codelen =
    let margs = [JString name ; JFlagsList flags ; JArgsList args ; JInt nregs ; JInt codelen] in
    new_mobj "MFunc2Decl" (JArray margs)

let newFuncDecl name args codelen =
    new_mobj "MFuncDecl" (JArray [JString name ; JStringList args ; JInt codelen])
*)
;;